home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
gsdb25.zip
/
GSDBLOOK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-03
|
13KB
|
538 lines
program GSdBLook;
uses
CRT,
DOS,
Printer,
GS_FileH,
GS_KeyI,
GS_dBFld,
GS_Pick,
GS_Winfc,
GS_dBTbl,
GS_dBase;
const
Initial_Count = 7;
Initial_Choice : array [1..Initial_Count] of string[9] =
(' Edit',' Append',' Select',' Print',
' Pack',' Info',' Exit');
type
Look_Obj = object(GS_dBFld_Objt)
constructor Init(FName : string);
procedure StatusUpdate(statword1,statword2,
statword3 : longint); virtual;
end;
var
Look : Look_Obj;
LookIndex,
LookName : string;
CreditWin,
FileWin,
FieldWin,
PrintWin,
AskWin,
StatusWin,
TalkWin,
LookWin : GS_Wind_Objt;
LookTab : dbTabl_Pick_Obj;
L : PathStr;
constructor Look_Obj.Init(FName : string);
begin
GS_dBFld_Objt.Init(FName);
TalkWin.InitWin(10,10,70,15,Blue,LightGray,Yellow,LightGray,Black,true,
'',true);
end;
procedure Look_Obj.StatusUpdate(statword1,statword2,statword3 : longint);
begin
case statword1 of
StatusStart : begin
case statword2 of
StatusPack : TalkWin.NamWin('[ Pack Progress ]');
StatusIndexTo : TalkWin.NamWin
('[ Index Progress ]');
end;
TalkWin.SetWin;
GotoXY(26,3);
write('Total Records to Process = ',statword3);
end;
StatusStop : TalkWin.RelWin;
StatusPack,
StatusIndexTo : begin
GoToXy(2,3);
write('Record Number ',statword2,' ');
end;
end;
end;
function SelField(MemoOk : boolean) : string;
var
FilTabl : array[1..128] of string[12];
Labl : string;
itms : integer;
slct : integer;
lctn : integer;
begin
itms := 0;
lctn := 0;
while itms < Look.NumFields do
begin
inc(itms);
if MemoOk then
begin
inc(lctn);
FilTabl[lctn] := Look.FieldsN^[itms];
end
else
begin
if Look.Fields^[itms].FieldType <> 'M' then
begin
inc(lctn);
FilTabl[lctn] := Look.FieldsN^[itms];
end;
end;
end;
FieldWin.SetWin;
slct := GS_Pick_Row_Item(FilTabl, 13, lctn, 1);
FieldWin.RelWin;
if slct > 0 then Labl := FilTabl[slct] else Labl := '';
SelField := Labl;
end;
function GetExt(pth, ext : string; LookElseWhere : boolean) : string;
var
Labl : string;
begin
FileWin.SetWin;
Labl := GS_FileFindFiles(pth,ext,LookElseWhere);
FileWin.RelWin;
if Labl = '-' then Labl := '';
GetExt := Labl;
end;
procedure FileEdit;
var
i,
ml : integer;
vl,
vs : boolean;
aw : string[1];
begin
StatusWin.SetWin;
write('':10,'ESC to Abort, F10 For Next Record,',
' F9 to Delete/Undelete');
LookWin.SetWin;
if Look.RecNumber < 1 then
Look.GetRec(Top_Record)
else
Look.GetRec(Look.RecNumber);
vl := true;
while vl do
begin;
ClrScr;
begin
vs := false;
vl := Look.FieldUpdateScreen;
if not vl then
begin
if Look.RecChanged then
begin
AskWin.NamWin('');
AskWin.SetWin;
gotoxy(1,1);
writeln(' Record has been modified!');
write(' Save before exit? ');
aw := Look.EditString('Y',21,2,1);
vs := aw[1] in ['T','t','Y','y'];
AskWin.RelWin;
end;
end;
if vl or vs then
begin
Look.PutRec(Look.RecNumber);
if GS_KeyI_Chr = Kbd_PgUp then
Look.GetRec(Prev_Record)
else
Look.GetRec(Next_Record);
end;
end;
end;
LookWin.RelWin;
StatusWin.RelWin;
end;
procedure FileAppend;
var
i,
ml : integer;
vc,
vl,
vs : boolean;
aw : string[1];
begin
StatusWin.SetWin;
write('':10,'ESC to Quit, F10 For Next Record,',
' F9 to Delete/Undelete');
LookWin.SetWin;
Look.GetRec(Top_Record);
vl := true;
vc := true;
while vl do
begin;
ClrScr;
begin
vs := false;
vl := Look.FieldAppendScreen(vc);
vc := false;
if not vl then
begin
if Look.RecChanged then
begin
AskWin.NamWin('');
AskWin.SetWin;
gotoxy(1,1);
writeln(' Record has been modified!');
write(' Save before exit? ');
aw := Look.EditString('Y',21,2,1);
vs := aw[1] in ['T','t','Y','y'];
AskWin.RelWin;
end;
end;
if vl or vs then
begin
Look.Append;
LookTab.Reset_dBTabl;
end;
end;
end;
LookWin.RelWin;
StatusWin.RelWin;
end;
procedure ShowFile;
var
i,
ml : integer;
vl,
vs : boolean;
aw : string[1];
begin
StatusWin.SetWin;
write('':10,'ESC to Abort, F10 to Quit and Save,',
' F9 to Delete/Undelete');
LookWin.SetWin;
vl := true;
begin;
ClrScr;
if LookTab.Addrec then
begin
vs := false;
vl := Look.FieldAppendScreen(true);
if not vl then
begin
if Look.RecChanged then
begin
AskWin.NamWin('');
AskWin.SetWin;
gotoxy(1,1);
writeln(' Record has been modified!');
write(' Save before exit? ');
aw := Look.EditString('Y',21,2,1);
vs := aw[1] in ['T','t','Y','y'];
AskWin.RelWin;
end;
end;
if vl or vs then
begin
Look.Append;
LookTab.Reset_dBTabl;
end;
end
else
begin
vs := false;
vl := Look.FieldUpdateScreen;
if not vl then
begin
if Look.RecChanged then
begin
AskWin.NamWin('');
AskWin.SetWin;
gotoxy(1,1);
writeln(' Record has been modified!');
write(' Save before exit? ');
aw := Look.EditString('Y',21,2,1);
vs := aw[1] in ['T','t','Y','y'];
AskWin.RelWin;
end;
end;
if vl or vs then
begin
Look.PutRec(Look.RecNumber);
if GS_KeyI_Chr = Kbd_PgUp then
Look.GetRec(Prev_Record)
else
Look.GetRec(Next_Record);
end;
end;
end;
LookWin.RelWin;
StatusWin.RelWin;
end;
procedure FileDisplay;
var
t : string[8];
fn : string[12];
i : integer;
z,
wcr : boolean;
begin
fn := SelField(false);
if fn = '' then exit;
wcr := Look.Wait_CR;
Look.Wait_Cr := true;
AskWin.NamWin('[ Search Criteria ]');
AskWin.SetWin;
gotoxy(1,1);
write('Enter select criteria:');
t := Look.EditString('',8,2,20);
Look.Wait_CR := wcr;
AskWin.RelWin;
if GS_KeyI_Esc then exit;
LookTab.Reset_dBTabl;
repeat
StatusWin.SetWin;
write('':22,'ESC to Exit, RETURN to Select Entry');
if LookTab.Tabl = nil then
z := LookTab.Scan_dBTabl(fn,t,fn)
else
begin
LookTab.Pick_Win.SetWin;
z := LookTab.Choose_dBTabl;
LookTab.Pick_Win.RelWin;
end;
StatusWin.RelWin;
if z then ShowFile;
until not z;
LookTab.Reset_dBTabl;
end;
procedure Print_List;
var
i,
ml,
lines : integer;
swork : string;
vs : boolean;
aw : string[2];
fldtabl : array[1..128] of string[10];
fldlgth : array[1..128] of integer;
fldwork : string;
fldlctn,
mmolgth : integer;
procedure Page_Top;
var
i : integer;
begin
if lines > 0 then write(lst,#12);
for i := 1 to fldlctn do
write(lst,fldtabl[i],'':fldlgth[i] - length(fldtabl[i]),' ');
writeln(lst);
writeln(lst);
lines := 2;
end;
begin
lines := 0;
fldlctn := 0;
PrintWin.SetWin;
Writeln('Print the following fields (Select from menu)');
repeat
fldwork := SelField(false);
if fldwork > '' then
begin
inc(fldlctn);
fldtabl[fldlctn] := fldwork;
write(fldwork,' ');
swork := Look.FieldGet(fldwork);
fldlgth[fldlctn] := Look.LastFldLth;
end;
until (fldwork = '') or (fldlctn >= 128);
if fldlctn = 0 then
begin
PrintWin.RelWin;
exit;
end;
AskWin.NamWin('');
AskWin.SetWin;
gotoxy(1,2);
write(' Do you want to print this?');
aw := Look.EditString('',29,2,1);
vs := aw[1] in ['T','t','Y','y'];
AskWin.RelWin;
if not vs then
begin
PrintWin.RelWin;
exit;
end;
Page_Top;
Look.GetRec(Top_Record);
while not Look.File_EOF do
begin
for i := 1 to fldlctn do
begin
fillchar(swork,sizeof(swork),' ');
swork := Look.FieldGet(fldtabl[i]);
if length(swork) < length(fldtabl[i]) then
swork[0] := chr(length(fldtabl[i]));
write(lst,swork,' ');
end;
writeln(lst);
inc(lines);
if lines > 58 then Page_Top;
Look.GetRec(Next_Record);
end;
PrintWin.RelWin;
end;
procedure FilePack;
var
ia : boolean;
fm : string;
begin
ia := Look.dbfNdxActv;
if ia then fm := Look.dbfNdxTbl[1]^.Ndx_Key_Form;
ClrScr;
gotoxy(37,12);
write('Packing');
Look.Pack;
ClrScr;
if ia then
begin
gotoxy(37,12);
write('Indexing');
Look.IndexTo(LookIndex,fm);
Look.Index(LookIndex);
ClrScr;
end;
Look.GetRec(Top_Record);
end;
procedure DisplayCredits;
begin
CreditWin.SetWin;
GoToXY(15,2);
write('Griffin Solutions');
GoToXY(18,4);
write('GS_dB Look');
GoToXY(16,6);
write('Copyright 1991');
GoToXY(4,8);
write('A program to read, write, and edit');
GoToXY(4,9);
write('dBase III files, including index and');
GoToXY(4,10);
write('memo files.');
GoToXY(4,12);
write('Usage: GSDBLOOK [filename [indexname]]');
GoToXY(4,13);
write('Where: filename is a dBase III file');
GoToXY(4,14);
write(' indexname is a dBase III index');
GoToXY(4,16);
write('The filename is optional. If omitted,');
GoToXY(4,17);
write('a menu of dBase files will be displayed.');
GoToXY(4,19);
write('ShareWare. $25.00 for Registration.');
StatusWin.SetWin;
Write('':27,'Press any Key to continue');
WaitForKey;
StatusWin.RelWin;
CreditWin.RelWin;
end;
procedure What_Now;
var
c1 : char;
q : integer;
begin
q := 1;
while q < Initial_Count do
begin
StatusWin.SetWin;
q := GS_Pick_Line_Item(Initial_Choice,10,Initial_Count,q);
StatusWin.RelWin;
case q of
1 : FileEdit;
2 : FileAppend;
3 : FileDisplay;
4 : Print_List;
5 : FilePack;
6 : DisplayCredits;
end;
end;
end;
begin
ClrScr;
CreditWin.InitWin(18,3,63,23,Yellow,Green,LightGray,Blue,LightGray,true,
'',true);
LookWin.InitWin(1,1,80,24,Yellow,Blue,LightGray,Blue,LightGray,true,
'',true);
AskWin.InitWin(20,8,60,11,Blue,LightGray,Yellow,LightGray,Black,true,
'',true);
StatusWin.InitWin(1,25,80,25,Yellow,Red,Yellow,Red,LightGray,false,'',true);
FileWin.InitWin(5,5,55,20,Yellow,Blue,LightGray,Black,Cyan,True,
'[ FILE SELECT ]',true);
FieldWin.InitWin(32,2,48,15,Yellow,Black,Yellow,Black,LightGray,True,
'[ FIELD SELECT ]',true);
PrintWin.InitWin(1,16,80,24,Yellow,Blue,Yellow,Black,LightGray,True,
'[ PRINT FIELDS SELECT ]',true);
DisplayCredits;
StatusWin.SetWin;
ClrScr;
if ParamCount < 1 then
begin
Write('Select dBase File to Examine':53);
LookName := GetExt('','*.DBF',true);
ClrScr;
end else LookName := ParamStr(1);
if LookName = '' then halt;
Look.Init(LookName);
Look.Open;
FileWin.NamWin('[ INDEX ]');
if ParamCount < 1 then
begin
Write('Choose an index or [ESC]':51);
LookIndex := GetExt(LookName,'*.NDX',false);
Clrscr;
end else
if ParamCount > 1 then LookIndex := ParamStr(2)
else LookIndex := '';
if LookIndex <> '' then Look.Index(LookIndex);
StatusWin.RelWin;
Look.MemoWidth(72);
LookTab.Init_dbTabl(Look, '[ ITEMS ]',10,2,70,22,
Yellow,Blue,LightGray,Blue,LightGray);
LookTab.Append_dBTabl(true);
What_Now;
Look.Close;
end.